FishMarket 1.0/FishMarket v1.0.iso/fishies/076-100/disk_091/samples/demos/actdemo.adl

Text File | 1992-05-06 | 12KB | 598 lines

INCLUDE "standard.adl";        { Include the standard package }


{ The following are Object properties }

BROKEN  =  1;        { Is the robot damaged? }
TOLD    =  2;        { Have I told the robot something? }
BSTATE    = 17;        { State of the button }
    B_OFF    =  0;    { Button is off }
    B_FLASH    =  1;    { Button is flashing }
    B_LIT    =  2;    { Button is lit }


{ Global variables }

VAR
    RobSave[ 6 ],    { Saved sentence for the robot }
    Score;        { Current score }


{ Utility routines }

ROUTINE
    NoGo,     Sayer,    Myself,    Lifter,
    DoorCk,    TrapCk,    RobMov, BlueCk,
    Header,    Die,    Skore,    RobEntr,
    HatchSD;


{ Locations in the dungeon }

NOUN
    Redrm,        Bluerm,
    Greenrm,    Cellar,
    Endrm;


{ Immovable objects }

NOUN
    button( Bluerm ),
    door( Cellar ),
    hatch( Bluerm );


{ Objects which may become actors }

NOUN
    me( Redrm ),
    robot( Greenrm );

me(NOTAKE) = TRUE;


{ Room descriptions }

Redrm( LDESC ) =
    ($say
"You are in a large room which is illuminated by a bright
red glow.  Exits lie to the east and south.\n"
    )
;
Redrm( SDESC ) = ($return (Header "Red room" %0));
Redrm( LIGHT ) = TRUE;


Greenrm( LDESC ) =
    ($say
"You are in a smallish room which is illuminated by a pleasant
green glow.  The only exit is to the west.\n"
    )
;
Greenrm( SDESC ) = ($return (Header "Green room" %0));
Greenrm( LIGHT ) = TRUE;


Bluerm( LDESC ) =
    ($say
"You are in a tiny room which is barely illuminated by a
dim blue glow.  There is an exit to the north,"
    )
    (IF ($eq ($prop button BSTATE) B_LIT) THEN
        ($say
" and most of the floor has tilted up to reveal a hatch leading
down into blackness.  A button on the wall is glowing brightly."
        )
     ELSE
        ($say " and you seem to make out something on the floor.")
        (IF ($prop button BSTATE) THEN
            ($say "  A button on the wall is flashing urgently.")
         ELSE
            ($say "  There is a button on the wall.")
        )
    )
    ($say
"  Above the button is a sign that reads:\n\n"
"        DANGER!\n\n"
"         HIGH VOLTAGE!\n\n"
    )
;
Bluerm( SDESC ) =
    (IF %0 THEN ($return "Blue room"))
    ($say "Blue room.\n")
;
Bluerm( LIGHT ) = TRUE;


Cellar( LDESC ) =
    ($say
"You are in the cellar.  Far above you can be seen a dim
blue light."
    )
    (IF ($prop door OPENED) THEN
        ($say
"  An open door leads to the north.\n"
        )
     ELSE
        ($say
"  You can barely see the outline of a door to the north.\n"
        )
    )
;
Cellar( SDESC ) =
    ($return (Header "Cellar" %0))
;
Cellar( LIGHT ) = TRUE;


Endrm( LDESC ) =
    ($say
"You exit from the dark cellar into a land filled with singing birds,
blooming flowers, flowing streams, and bright blue skies.  In other words,
you have finished this game!\n"
    )
    ($setg Score ($plus @Score 25))
    (Skore)
    ($spec 3)
;
Endrm( LIGHT ) = TRUE;


{ Verbs }

VERB
    score,
    push,
    shout;

tell = TELLER;
say = tell;
press = push;
feel = touch;
yell = shout;


{ Verb routines }

tell( PREACT ) =
    (IF ($ne @Iobj robot) THEN
        { The only logical thing to talk to is the robot }
        (Sayer
"Talking to yourself is said to be a sign of impending insanity"
        )
     ELSEIF ($ge @Dobj 0) THEN
        { You must say strings }
        (Sayer
"You must put what you want to say in quotes"
        )
     ELSEIF ($ne ($loc robot) ($loc me)) THEN
        { The robot must be in the same place as the player }
        (IF (Myself) THEN
            ($say "You don't see the robot here.\n")
        )
     ELSE
        { Everything is OK.  Add 25 points to the score }
        (IF ($not ($prop robot TOLD)) THEN
            ($setg Score ($plus @Score 25))
            ($setp robot TOLD TRUE)
        )
        ($exit 0)
    )
    ($exit 1)
;
tell( ACTION ) =
    { Tell the player that we heard him }
    ($say "\"Sure thing, Boss.\"\n")

    { Delete the old action }
    ($delact robot)

    { Add the new action - a non-interactive actor }
    ($actor robot @Dobj FALSE)
;


shout( PREACT ) =
    (IF    ($and @Iobj ($ne @Iobj robot)) THEN
        { Shouting at things other than the robot }
        ($say "AAARRRGGGHHH!\n")
     ELSEIF    ($ge @Dobj 0) THEN
        { Shouting things other than strings }
        ($say "EEEYYYAAAHHH!\n")
     ELSEIF    ($prop robot BROKEN) THEN
        ($say "There is no response.\n")
     ELSE
        { Shouting at the robot - same as telling the robot }
        (IF ($not ($prop robot TOLD)) THEN
            ($setg Score ($plus @Score 25))
            ($setp robot TOLD TRUE)
        )
        ($exit 0)
    )
    ($exit 1)
;
shout( ACTION ) =
    { Tell the player we heard him }
    (IF ($ne ($loc robot) ($loc me)) THEN
        ($say "In the distance you hear the words, ")
    )
    ($say "\"Sure thing, Boss\"\n")

    { Delete the old robot action }
    ($delact robot)

    { Add the new robot action }
    ($actor robot @Dobj FALSE)
;


push( PREACT ) =
    { Expect a plain direct object }
    (Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
    (CheckAvail)
;
push( ACTION ) =
    (Sayer "That doesn't seem to do anything")
    ($exit 1)
;


score(PREACT) =
    { Score can accept no objects }
    (Expect NO_OBJ NO_OBJ)
    (Skore)
    ($exit 1)
;


{ Object properties }

button( SDESC ) =
    (IF ($eq ($prop button BSTATE) B_OFF) THEN
        ($say "a button")
     ELSEIF ($eq ($prop button BSTATE) B_FLASH) THEN
        ($say "an urgently flashing button")
     ELSE
        ($say "a brightly lit button")
    )
;
button( ACTION ) =
    (IF ($and    (Myself)
            ($or    ($eq @Verb push)
                ($eq @Verb take)
                ($eq @Verb touch)
            )
        )
     THEN
        { The player tried to do something with the button }
        ($say
"As you reach for the button, a 10,000,000 volt bolt of lightning
arcs toward your finger, disintegrating you upon impact.\n"
        )
        (Die)
     ELSEIF ($and ($eq @Verb push) ($eq ($prop button BSTATE) B_OFF)) THEN
        { The robot pushed the button }
        ($setp button BSTATE B_FLASH)
        ($setg Score ($plus @Score 50))
        ($sfus me Lifter 4)
        ($exit 1)
     ELSEIF ($eq @Verb take) THEN
        { Can't take the button }
        ($setg Skip TRUE)
    )
;


SimpleRobot = "I am just a simple robot";
robot( LDESC ) = ($say "There is a robot here.\n");
robot( SDESC ) = ($say "a robot");
robot( ACTION ) =
    (IF (Myself) THEN
        { I'm doing something with the robot }
        (IF ($eq @Verb tell) THEN
            (IF ($prop robot BROKEN) THEN
                ($say "There is no response.\n")
                ($exit 1)
                )
         ELSEIF ($eq @Verb take) THEN
            ($say "The robot weighs at least 500 pounds!\n")
            ($exit 1)
        )
     ELSEIF ($eq ($phase) 2) THEN
        { This is being called as the Actor ACTION }
        (ActAction)
        (IF ($and    ($ne @Verb push)
                ($ne @Verb go)
                ($ne @Verb wait)
                ($ne @Verb take)
                ($or ($lt @Verb north) ($gt @Verb down)))
         THEN
            { The robot has a VERY simple vocabulary }
            (Sayer SimpleRobot)
            ($delact robot)
            ($exit 1)
        )
     ELSEIF ($eq @Verb take) THEN
        { The robot is trying to take itself }
        (Sayer "Mmmph!  Akkk!!  GGGGRR!!  No can do.  Sorry")
        ($setg Skip TRUE)
     ELSE
        { The robot is doing something to itself }
        (Sayer SimpleRobot)
        ($delact robot)
        ($exit 1)
    )
;
robot( SAVESENT ) = RobSave;



{    We break me( ACTION ) out into a named routine because
    StdInit overwrites that property and we need to restore it    }

MeAct =
    (IF ($eq ($phase) 2) THEN
        { This is the Actor ACTION - call standard's actor action }
        (ActAction)
     ELSEIF ($eq @Verb take) THEN
        (Sayer "I thought you would never ask")
        ($setg Skip TRUE)
    )
;


{    We break hatch( SDESC ) out into a named routine because
    the hatch isn't visible until after Lifter has executed        }

HatchSD = ($say "an open hatch");
HatchMSG = "The hatch doesn't budge";
hatch( ACTION ) =
    (IF ($eq @Verb take) THEN
        { Can't take the hatch }
        (Sayer HatchMSG)
        ($setg Skip TRUE)
     ELSEIF ($or ($eq @Verb open) ($eq @Verb push)) THEN
        { Can't open or push it, either }
        (Sayer HatchMSG)
        ($exit 1)
    )
;
hatch( OPENS ) = TRUE;
hatch( NOTAKE ) = TRUE;


door( SDESC ) = ($say "a door");
door( ACTION ) =
    (IF ($eq @Verb take) THEN
        ($say "You can't take a door!\n")
        ($setg Skip TRUE)
    )
;
door( OPENS ) = TRUE;


{    Transition routines.  Note that RobMov is used in $miss.
    This produces the 'The robot exits to the <direction>
    messages.  The calls to RobEntr produce the messages like
    'The robot enters from the <direction>.        }

Bluerm( ACTION ) =
    ($miss RobMov NoGo NoGo NoGo NoGo TrapCk 0 0 0 0)
    ($hit .ME Redrm 0 0 0 0 Cellar 0 0 0 0)
    (RobEntr)
;


Redrm( ACTION ) =
    ($miss NoGo BlueCk RobMov NoGo NoGo NoGo 0 0 0 0)
    ($hit .ME 0 Bluerm Greenrm 0 0 0 0 0 0 0)
    (RobEntr)
;


Greenrm( ACTION ) =
    ($miss NoGo NoGo NoGo RobMov NoGo NoGo 0 0 0 0)
    ($hit .ME 0 0 0 Redrm 0 0 0 0 0 0)
    (RobEntr)
;


Cellar( ACTION ) =
    ($miss DoorCk NoGo NoGo NoGo BlueCk NoGo 0 0 0 0)
    ($hit .ME Endrm 0 0 0 Bluerm 0 0 0 0 0)
    (RobEntr)
;


{ Routines }

{ (Myself) - returns 1 if "me" is the current actor; 0 otherwise }
Myself =
    ($return ($eq .ME me))
;


{    (Sayer str) - Says a string with appropriate quoting, depending
    on whether the robot or the player is doing the saying.        }
Sayer =
    (IF (Myself) THEN
        ($say %1 ".\n")
     ELSEIF ($eq ($loc robot) ($loc me)) THEN
        ($say "\"" %1 ", Boss.\"\n")
     ELSE
        ($say "You hear a muffled voice in the distance.\n")
    )
;


{    (NoGo) - "You can't go that way"    }
NoGo =
    (Sayer "You can't go that way")
    ($exit 1)
;


{    (Header str arg0) - To accomplish the printing of header lines,
    each location SDESC need to return a string if a parameter is
    passed to it.  By doing ($return (Header <sdesc> %0)), we can
    centralize the saying/returning decision.    }
Header =
    (IF ($not %2) THEN
        ($say %1 ".\n")
    )
    ($return %1)
;


RobMov =
    (IF ($and ($not (Myself)) ($eq ($loc robot) ($loc me))) THEN
        ($say
            "The robot exits to the "
            (IF ($eq @Verb e) THEN
                ($val "east")
             ELSEIF ($eq @Verb w) THEN
                ($val "west")
             ELSEIF ($eq @Verb s) THEN
                ($val "south")
             { The robot can't be seen leaving to the north }
            )
            ".\n"
        )
    )
;


RobEntr =
    (IF ($and ($not (Myself)) ($eq ($loc robot ) ($loc me))) THEN
        ($say
            (IF ($eq @Verb north) THEN
                ($val "The robot enters from the south.\n")
             ELSEIF ($eq @Verb east) THEN
                ($val "The robot enters from the west.\n")
             ELSEIF ($eq @Verb west) THEN
                ($val "The robot enters from the east.\n")
             { The robot can't enter from the north in
               this scenario }
            )
        )
    )
;


DoorCk =
    (IF ($not ($prop door OPENED)) THEN
        ($say "The door seems to be closed.\n")
        ($exit 1)
    )
;


TrapCk =
    (IF ($ne ($prop button BSTATE) B_LIT) THEN
        (NoGo)
    )
;


{    (BlueCk) - make sure that only one actor is in the blue room
    at one time.    }
BlueCk =
    (IF ($or ($eq ($loc me) Bluerm) ($eq ($loc robot) Bluerm)) THEN
        (IF (Myself) THEN
            ($say
"The room is too small for both you and the robot to fit.\n"
            )
        )
        ($exit 1)
     ELSEIF ($and ($not (Myself)) ($eq ($prop button BSTATE) B_LIT)) THEN
        (RobMov)
        ($say "You hear a loud CRASH! in the distance.\n")
        ($setg Score ($minus @Score 10))
        ($setp robot BROKEN TRUE)
        ($move robot Bluerm)
        ($delact robot)
        ($exit 1)
    )
    (RobMov)
;


{    (Die) - kill off the player    }
Die =
    ($setg Score ($minus @Score 50))
    (Skore)
    ($say "Do you wish to restart the game? ")
    (IF ($yorn) THEN
        ($spec 2)
     ELSE
        ($spec 3)
    )
;


{    (Lifter) - Lift the hatch, possibly killing the robot or
    the player    }
Lifter =
    (IF ($eq ($loc me) Bluerm) THEN
        ($say
"All of a sudden, the floor lifts up, and you are crushed between it
and the wall!  "
        )
        (Die)
     ELSE
        ($say "In the distance, you hear a loud CRASH!\n")
        (IF ($eq ($loc robot) Bluerm) THEN
            ($setg Score ($minus @Score 10))
            ($setp robot BROKEN TRUE)
            ($delact robot)
        )
    )
    ($setp hatch SDESC HatchSD)
    ($setp button BSTATE B_LIT)
    ($setp Bluerm SEEN FALSE)
;


{    Prompt - print the status line and a prompt    }
PROMPT =
    ($spec 9 (($sdesc ($loc .ME)) 1) @Score ($turns))
    ($say "> ")
;


{    Increment - increment the turn counter    }
INCREMENT =
    (IF (Myself) THEN
        { We only want to increment once per turn }
        ($incturn)
     ELSE
        { We don't want Looker executing for the robot }
        ($exit 0)
    )
;


{    (Skore) - print out the current score.    }
Skore =
    ($say    "You have scored " ($str @Score)
        " out of a possible 100 in " ($str ($turns)) " moves.\n")
;


{    Dwimming routines    }
DWIMI = (Dwimmer %1);
DWIMD = (Dwimmer %1);

START =
    ($spec MARGIN 69)    { Set the screen to 69 wide }
    ($sdem INCREMENT)    { Turn counter increment }
    (StdInit me)        { Initialize standard }
    ($setp me ACTION MeAct)    { Restore me( ACTION ) }
    ($setv n s e w u d 0 0 0 0)    { Use our own transition vector }
    ($prompt PROMPT)    { and our own prompter }
    ($setg Indent TRUE)    { Indent the object descriptions }
;

{*** EOF actdemo.adl ***}